home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 026a / force2.zip / DISPSTRU.PRG < prev    next >
Text File  |  1990-08-12  |  5KB  |  178 lines
  1. *:*********************************************************************
  2. *:
  3. *:        Program: DISPSTRU.PRG
  4. *:
  5. *:         System: Display DBF file structure
  6. *:         Author: John Wright
  7. *:      Copyright (c) 1990, WRIGHTware
  8. *:  Last modified: 08/12/90
  9. *:
  10. *:  Procs & Fncts: FORCE_MAIN
  11. *:
  12. *:      Documented 08/12/90                         SNAP!  version 4.02h
  13. *:*********************************************************************
  14. * Created - 08/08/90 - Display DBF structure with FORCE.
  15. * Revised - 08/10/90 - Fixed a bug - initialize FLD_NAME before DO WHILE.
  16. *                      Added some file header information.
  17. * Revised - 08/12/90 - Added ability to redirect output using FB_WRITE.
  18. *                      Use FIND_FILE functions to process DOS wildcards.
  19.  
  20. #INCLUDE fileio.hdr
  21. #INCLUDE string.hdr
  22. #INCLUDE system.hdr
  23. #INCLUDE io.hdr
  24.  
  25. #PRAGMA w_func_proc-
  26.  
  27. *!*********************************************************************
  28. *!
  29. *!      Procedure: FORCE_MAIN
  30. *!
  31. *!*********************************************************************
  32. PROCEDURE force_main
  33. PARAMETERS CHAR cmd_line
  34.  
  35. VARDEF
  36.   CHAR      cr_lf
  37.   CHAR      pattern
  38.   CHAR      dbf_path
  39.   CHAR      dbf_name
  40.   CHAR      txt_line
  41.   CHAR(3)   lst_updt
  42.   UINT      handle
  43.   * field info
  44.   CHAR(10)  fld_name
  45.   CHAR(1)   fld_type
  46.   CHAR(1)   fld_len
  47.   CHAR(1)   fld_dec
  48.   INT       fld_num
  49.   INT       rec_size
  50.   INT       spot
  51. ENDDEF
  52.  
  53. STORE cmd_line TO pattern
  54.  
  55. IF pattern = ""
  56.   ?"Syntax:  DISPSTRU <dbf>                  display on screen"
  57.   ?"         DISPSTRU <dbf> >PRN             send to printer"
  58.   ?"         DISPSTRU <dbf> >FILENAME.TXT    redirect to a file"
  59.   ?""
  60.   QUIT
  61. ENDIF
  62.  
  63. IF ".DBF" $ UPPER(pattern)
  64.   STORE UPPER(LTRIM(RTRIM(pattern))) TO pattern
  65. ELSE
  66.   STORE UPPER(LTRIM(RTRIM(pattern)))+".DBF" TO pattern
  67. ENDIF
  68.  
  69. * Save path if specified (FIND_FSTR only returns the file name)
  70. IF "\" $ pattern
  71.   STORE UPPER(SUBSTR(pattern,1,RAT("\",pattern))) TO dbf_path
  72. ENDIF
  73.  
  74. * search for matching file(s)
  75. IF find_first(pattern,0x20)
  76.  
  77.   STORE CHR(13)+CHR(10) TO cr_lf
  78.  
  79.   REPEAT
  80.  
  81.     STORE dbf_path+find_fstr() TO dbf_name
  82.  
  83.     IF .NOT. Fb_open(handle,dbf_name,&B_READ)
  84.       ?"ERROR:  Cannot open file => "+dbf_name
  85.       ?""
  86.       ?CHR(7)
  87.       QUIT
  88.     ENDIF
  89.  
  90.     STORE 0 TO fld_num,rec_size
  91.  
  92.     FB_write(&STD_OUT,cr_lf,2)
  93.     STORE "Name of database file: "+dbf_name+cr_lf TO txt_line
  94.     FB_write(&STD_OUT,txt_line,LEN(txt_line))
  95.  
  96.     * Cannot get the number of records because it is stored as
  97.     * a four digit binary number.
  98.  
  99.     * date of last update is stored as a three digit character string in header
  100.     Fb_seek(handle,1,&fb_begin)
  101.     Fb_read(handle,lst_updt,3)
  102.     * a whole lot of code just to print a "nice" date...
  103.     STORE "Date of last update  : "+;
  104.     RIGHT("00"+LTRIM(STR(ASC(SUBSTR(lst_updt,2,1)),2,0)),2)+"/"+;
  105.     RIGHT("00"+LTRIM(STR(ASC(SUBSTR(lst_updt,3,1)),2,0)),2)+"/"+;
  106.     STR(ASC(SUBSTR(lst_updt,1,1)),2,0)+cr_lf TO txt_line
  107.     FB_write(&STD_OUT,txt_line,LEN(txt_line))
  108.  
  109.     STORE "Field  Field name  Type        Width   Dec"+cr_lf TO txt_line
  110.     FB_write(&STD_OUT,txt_line,LEN(txt_line))
  111.  
  112.     * process the DBF header
  113.     STORE " " TO fld_name
  114.     DO WHILE SUBSTR(fld_name,1,1) <> CHR(13)
  115.       STORE fld_num+1 TO fld_num
  116.       STORE (fld_num*32) TO spot
  117.       Fb_seek(handle,spot,&fb_begin)
  118.       * check the first character - a CHR(13) means end of field definitions
  119.       Fb_read(handle,fld_name,1)
  120.       IF SUBSTR(fld_name,1,1) <> CHR(13)
  121.         * get field name
  122.         Fb_seek(handle,spot,&fb_begin)
  123.         Fb_read(handle,fld_name,10)
  124.         * field type  -  11th position
  125.         STORE (fld_num*32)+11 TO spot
  126.         Fb_seek(handle,spot,&fb_begin)
  127.         Fb_read(handle,fld_type,1)
  128.         STORE SUBSTR(fld_type,1,1) TO fld_type
  129.         * field length - 16th position
  130.         STORE (fld_num*32)+16 TO spot
  131.         Fb_seek(handle,spot,&fb_begin)
  132.         Fb_read(handle,fld_len,1)
  133.         * field decimal - 17th position
  134.         Fb_read(handle,fld_dec,1)
  135.         * print the field and continue
  136.         STORE STR(fld_num,5,0)+"  "+SUBSTR(fld_name+SPACE(12),1,12) TO txt_line
  137.         DO CASE
  138.         CASE fld_type = "C"
  139.           STORE txt_line+"Character" TO txt_line
  140.         CASE fld_type = "D"
  141.           STORE txt_line+"Date     " TO txt_line
  142.         CASE fld_type = "L"
  143.           STORE txt_line+"Logical  " TO txt_line
  144.         CASE fld_type = "M"
  145.           STORE txt_line+"Memo     " TO txt_line
  146.         CASE fld_type = "N"
  147.           STORE txt_line+"Numeric  " TO txt_line
  148.         OTHERWISE
  149.           STORE txt_line+"unknown  " TO txt_line
  150.         ENDCASE
  151.         STORE txt_line+STR(ASC(fld_len),8,0) TO txt_line
  152.         rec_size=rec_size+ASC(fld_len)
  153.         IF fld_type = "N"
  154.           STORE txt_line+STR(ASC(fld_dec),6,0) TO txt_line
  155.         ENDIF
  156.         STORE txt_line+cr_lf TO txt_line
  157.         FB_write(&STD_OUT,txt_line,LEN(txt_line))
  158.       ENDIF
  159.     ENDDO
  160.     STORE "** Total **"+STR((rec_size+1),25,0)+cr_lf TO txt_line
  161.     FB_write(&STD_OUT,txt_line,LEN(txt_line))
  162.     FB_write(&STD_OUT,cr_lf,2)
  163.  
  164.     Fb_close(handle)
  165.  
  166.   UNTIL .NOT. find_next()
  167.  
  168. ELSE
  169.   ?"ERROR:  No files found matching => "+pattern
  170.   ?""
  171. ENDIF
  172.  
  173. QUIT
  174.  
  175. ENDPRO
  176.  
  177. *: EOF: DISPSTRU.PRG
  178.